      SUBROUTINE ABORT(ERRLEV,ICODE,STRING,IPAR,IVAL,IFLAG)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C     This routine issues error-messages and aborts the calling
C     program or returns to it. ERRLEV determines the type of action:
C     'F'---fatal error by call to subr.SYSTEM
C     'W'---warning by call to subr.SYSTEM and return
C     'S'---warning by call to subr.SYSTEM and stop
C
C     IFLAG is a flag which is passed to subr.SETR1G (intended for
C     communication with the operating system).
C
C     Error-messages are printed and one message is passed to 
C     subr. MESSGE (can be put in separate dayfile, logfile etc.).
C
C     The following options are available (ICODE):
C     1---end of file encountered
C         STRING---definition of the record expected
C         IPAR  ---name of subroutine
C         IVAL  ---unit number
C     2---inconsistent input data
C         STRING---indication of the error
C         IPAR  ---name of subroutine
C     3---dimension bound exceeded because program parameters are
C         too small to run with the input-data
C         STRING---indication of location where error was detected
C         IPAR  ---name of the parameter to be changed
C         IVAL  ---indication of the least value to assign to parameter
C     4---dimension bound exceeded because of internal program errors
C         STRING---indication of location where error was detected
C         IPAR  ---relevant string value
C         IVAL  ---relevant numerical value
C     5---non matching parameters
C         STRING---place error occurred
C         IPAR  ---parameter in error
C         IVAL  ---previous value for parameter
C     6---any program error
C         STRING---indication of error
C         IPAR  ---name of subroutine
C     7---error in algorithm
C         STRING---indication of error
C         IPAR  ---name of subroutine
C     8---user error (as inconsistent input)
C         STRING---indication of the error
C         IPAR  ---relevant string value
C         IVAL  ---relevant numerical value
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      CHARACTER STRING*(*),AST*4,IPAR*(*),DAY*4,ERRLEV
      CHARACTER STR*60,JPAR*7
      CHARACTER TXT1*35,TXT2*25,TXT3*26,TXT4*41,TXT5*25,TXT6*25,TXT7*20
      DATA AST,DAY/' >>>','DAYF'/
      DATA TXT1/'END OF FILE ENCOUNTERED, EXPECTED: '/
      DATA TXT2/'INCONSISTENT INPUT DATA: '/
      DATA TXT3/'DIMENSION BOUND EXCEEDED: '/
      DATA TXT4/'DIMENSION BOUND EXCEEDED -- PROGRAM ERROR'/
      DATA TXT5/'NON MATCHING PARAMETERS: '/
      DATA TXT6/'PROGRAM EXECUTION ERROR: '/
      DATA TXT7/'ERROR IN ALGORITHM: '/
C
      CALL SETR1G(IFLAG)
      STR=STRING
      LT=LENSTR(STR)
      LS=LENSTR(STRING)
      JPAR=IPAR
      NERR=51
      IF (ERRLEV.EQ.'F') NERR=52
      WRITE (*,100)
      GOTO (10,20,30,40,50,60,70,80) ICODE
   10 WRITE (*,200) AST,TXT1,STRING(1:LS)
      WRITE (*,400) AST,IPAR
      WRITE (*,500) AST,IVAL
      CALL MESSGE(TXT1//STR(1:LT),DAY)
      CALL SYSTEM(NERR,AST//'PREMATURE END OF FILE')
      IF (ERRLEV.EQ.'W') RETURN
      STOP '-- STOP FORCED -- CHECK INPUT DECK FOR MISSING DATA --'
   20 WRITE (*,200) AST,TXT2,STRING(1:LS)
      WRITE (*,400) AST,IPAR
      CALL MESSGE(TXT2//STR(1:LT),DAY)
      CALL SYSTEM(NERR,AST//'INCONSISTENT DATA. PROBABLY USER ERROR')
      IF (ERRLEV.EQ.'W') RETURN
      STOP '-- INCONSISTENT DATA -- PROGRAM ABORTED --'
   30 WRITE (*,200) AST,TXT3
      WRITE (*,200) AST,'ERROR OCCURRED AT ',STRING(1:LS)
      WRITE (*,300) AST,'PARAMETER ',JPAR,' SHOULD BE AT LEAST',IVAL
      CALL MESSGE(TXT3//JPAR//' AT '//STR(1:LT),DAY)
      CALL SYSTEM(NERR,AST//'PARAMETER TOO SMALL')
      IF (ERRLEV.EQ.'W') RETURN
      STOP '-- STOP FORCED -- ENLARGE PARAMETER --'
   40 WRITE (*,200) AST,TXT4
      WRITE (*,200) AST,'ERROR OCCURRED AT ',STRING(1:LS)
      WRITE (*,600) AST,IPAR,IVAL
      CALL MESSGE(TXT4//STR(1:LT),DAY)
      CALL SYSTEM(NERR,AST//'DIMENSION BOUND INCORRECT')
      IF (ERRLEV.EQ.'W') RETURN
      STOP '-- STOP FORCED -- CORRECT PROGRAM --'
   50 WRITE (*,200) AST,TXT5,STRING(1:LS)
      WRITE (*,300) AST,'PARAMETER ',JPAR,' SHOULD BE AT LEAST',IVAL
      CALL MESSGE(TXT5//JPAR//' AT '//STR(1:LT),DAY)
      CALL SYSTEM(NERR,AST//'CONFLICTING PARAMETERS')
      IF (ERRLEV.EQ.'W') RETURN
      STOP '-- STOP FORCED -- NON MATCHING PARAMETERS --'
   60 WRITE (*,200) AST,TXT6,STRING(1:LS)
      WRITE (*,400) AST,IPAR
      CALL MESSGE(TXT6//STR(1:LT),DAY)
      CALL SYSTEM(NERR,AST//'FATAL RUN-TIME CONDITION')
      IF (ERRLEV.EQ.'W') RETURN
      STOP '-- STOP FORCED -- PROGRAM EXECUTION ERROR --'
   70 WRITE (*,200) AST,TXT7,STRING(1:LS)
      WRITE (*,400) AST,IPAR
      CALL MESSGE(TXT7//STR(1:LT),DAY)
      CALL SYSTEM(NERR,AST//'ERROR IN ALGORITHM')
      IF (ERRLEV.EQ.'W') RETURN
      STOP 'ALGORITHMIC ERROR -- CORRECT PROGRAM'
   80 WRITE (*,200) AST,TXT2,STRING(1:LS)
      WRITE (*,600) AST,IPAR,IVAL
      CALL MESSGE(TXT2//STR(1:LT),DAY)
      CALL SYSTEM(NERR,AST//'INCONSISTENT DATA. PROBABLY USER ERROR')
      IF (ERRLEV.EQ.'W') RETURN
      STOP '-- INCONSISTENT DATA -- PROGRAM ABORTED --'
  100 FORMAT(//)
  200 FORMAT(3A)
  300 FORMAT(4A,I5)
  400 FORMAT(A,'SUBROUTINE: ',A)
  500 FORMAT(A,'UNIT NUMBER: ',I3)
  600 FORMAT(A,'STRING PASSED: ',A,', VALUE PASSED: ',I8)
      END
      SUBROUTINE CNSTAN
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C     SUBROUTINE CNSTAN                                                C
C     BOHR   : 1 AU    = 'VALUE' ANGSTROM                              C
C     HARTREE: 1 AU    = 'VALUE' KILOJOULE/MOLE                        C
C     DEBYE  : 1 DEBYE = 'VALUE' AU                                    C
C     DBETA  : INVERSE BOLTZMANN CONSTANT IN K/AU                      C
C     CALORY : 1 CAL   = 'VALUE' JOULE                                 C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      INCLUDE 'COM_CONST.INC'
C
      CLIGHT=HARTRE
      ELCHA=DEBYE
      HARTRE = (ELCHA * CLIGHT)**2   *   1.E-7   /   (BOHR*1.E-10)
      DEBYE = 1.E-11   /   (CLIGHT * BOHR * ELCHA)
      DBETA = HARTRE / DBETA
      HARTRE = HARTRE * AVOG * 1.E-3
      CALORY = 1.E0 / CALORY
      RETURN
      END
      SUBROUTINE HEADRT(PNAME,VERSN)
C
C.... aim: print standard header
C
      INCLUDE 'TXTFIL.INC'
      INCLUDE 'COM_JOBD.INC'
      CHARACTER*(*) PNAME,VERSN
      CHARACTER*80  STAR
C
      DO 10 I=1,80
      STAR(I:I) = '*'
  10  CONTINUE
C
      PNM  = PNAME
      IPNM = LENSTR(PNAME)
      IVERS= LENSTR(VERSN)
C
      PRINT *, ' '
      PRINT *, ' *** Program ',PNAME(1:IPNM)
     +                ,' *** Version ',VERSN(1:IVERS),' ***'
      PRINT *, ' '
      PRINT *, '     written by Ton Rullmann'
      PRINT *, '     Department of Organic Chemistry'
      PRINT *, '     University of Utrecht, The Netherlands'
      PRINT *, ' '
      PRINT *, '     (c) 1989'
      PRINT *, ' '
      PRINT *, ' ',STAR(1:IPNM+IVERS+29)
      PRINT *, ' '
      RETURN
      END
      SUBROUTINE FOOTER
C
C.... aim: print standard footer belonging to header
C
      INCLUDE 'TXTFIL.INC'
      INCLUDE 'COM_JOBD.INC'
C
      WRITE (ITXOUT,1000) PNM(1:LENSTR(PNM))
C
 1000 FORMAT (//'  *** End program ',A,' ***'/)
C
      STOP
      END
      SUBROUTINE BUSY (TEXT)
C
C.... aim: print message about what the program is doing
C
      INCLUDE 'TXTFIL.INC'
      INCLUDE 'COM_JOBD.INC'
      CHARACTER*(*) TEXT
C
      WRITE (ITXOUT,1000) PNM(1:LENSTR(PNM)),TEXT(1:LENSTR(TEXT))
C
 1000 FORMAT ('0 <',A,'> ... ',A)
C
      RETURN
      END
      SUBROUTINE STARTR(ORG,ALT)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     SUBROUTINE STARTR
C     Retrieves current date and time (subr. GETDAT, GETTIM)
C     Retrieves compilation date and time (subr. CMPILX)
C     Retrieves operating system parameters (subr.JOBJE)
C     ORG = 'B' : BATCH processing mode (IAF set to .false.)
C         = 'I' : INTERACTIVE processing mode (IAF set to .true.)
C         = '?' : read mode from input
C     ALT = 'Y' : use alternate output file (ALTOUT set to .true.)
C         = 'N' : do not use alternate output file (ALTOUT set to .false.)
C         = '?' : read mode from input
C     Note: when after the call to JOBJE IAF is .false. (i.e. the process is
C           qualified as BATCH by the operating system) the values of
C           ORG and ALT are ignored, i.e. IAF and ALTOUT are both .false..
C           This depends of course on JOBJE (the default return value -
C           if no access to the o.s. is made - should be .true.)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      INCLUDE 'COM_JOBD.INC'
      CHARACTER*(*) ORG,ALT
      CHARACTER*10 GETDAT,GETTIM,CH*1
C
    1 FORMAT(A)
   10 FORMAT(' PROGRAM COMPILED ON',A10,' AT',A10/,
     +       ' TODAY IS',11X,A10,3X,A10)
   20 FORMAT(' PROCESSING MODE BATCH OR INTERACTIVE? TYPE B OR I')
   30 FORMAT(' USE ALTERNATE OUTPUT FILE? TYPE Y OR N')
C
C----- get and print compilation and current dates and times
      DATE=GETDAT()
      TIME=GETTIM()
      CALL CMPILX
      WRITE (*,10) CMPDAT,CMPTIM,DATE,TIME
C----- get operating system parameters
      CALL JOBJE
C----- default no alternate output file
      ALTOUT=.false.
C----- use default setting in BATCH mode
      IF (.NOT.IAF) GOTO 100
C----- set processing mode (BATCH or INTERACTIVE)
      CH=ORG(1:1)
      IF (CH.EQ.'?') THEN
         WRITE (*,20)
         READ (*,1) CH
      ENDIF
      IAF=UPPRCS(CH).NE.'B'
C----- set alternate output mode
      CH=ALT(1:1)
      IF (CH.EQ.'?') THEN
         WRITE (*,30)
         READ (*,1) CH
      ENDIF
      ALTOUT=UPPRCS(CH).NE.'N'
C
  100 RETURN
      END
      SUBROUTINE PRTIME(NT,IOP,TIM,STRING)
C**********************************************************************
C     Subroutine PRTIME prints STRING and the accumulated CPU time
C     (delivered by GETCPT) minus TIM. After exit from the routine
C     TIM has been replaced by the accumulated CPU time (and can be
C     passed in the next call as the new offset).
C     If IOP.eq.1 the string is also passed to MESSGE.
C     NT is the unit number for print output.
C**********************************************************************
C
      CHARACTER*(*) STRING
C
   10 FORMAT(//1X,A,F8.3,' CPU SECONDS'/)
      T=TIM
      CALL GETCPT(TIM)
      WRITE (NT,10) STRING(1:LENSTR(STRING)),TIM-T
      IF (IOP.EQ.1) CALL MESSGE(STRING,'DISP')
      RETURN
      END
